home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 8 / Eagles_Nest_Mac_Collection_Disc_8.TOAST / Developer Tools⁄Additions / InsideBa1994 / InsideBasic-94 / IB 94 / Offscreen Animation / OffScreen Animation (Z) < prev   
Text File  |  1992-07-30  |  8KB  |  269 lines

  1. '----------------------------------------------
  2. ' QuickDraw Offscreen Animation Demo (ZBasic)
  3. ' by Ross W. Lambert
  4. ' Copyright (C) 1991
  5. ' All Rights Reserved
  6. '----------------------------------------------
  7.  
  8. COORDINATE WINDOW
  9. DEF MOUSE=-1:WIDTH -2
  10.  
  11.  
  12. ' ---------------- Resources
  13.  
  14. 'Hndl& = FN GETRESOURCE(CVI("Ross"),0) ' unREM for Z5
  15. 'LONG IF Hndl& = 0
  16. 'ResRef = FN OPENRESFILE("Animation.res")
  17. 'IF ResRef = 0 THEN END
  18. 'END IF
  19.  
  20. RESOURCES "Animation.Res"         ' comment out for Z5
  21.  
  22. ' ---------------- Data Structures
  23.  
  24. DIM T,L,B,R                       'temp working rectangle
  25.  
  26. SaucerID = 2000                   'starting resource ID of saucer shape set
  27. SaucerPICTs = 6                   'number images in saucer set
  28.  
  29. RockID = 3000                     'starting res ID of rock PICT bank
  30. RockPICTs = 12                    'images in rock bank (change to suit)
  31.  
  32. DIM ShRect(9,3)                   'screen coordinates for each shape
  33. DIM XInc(9), YInc(9)              'movement increments in pixels, x & y
  34. DIM IntShape(9)                   'Curr shape num (for internal animation)
  35. DIM MoveLimits(9,3)               'rects describing movement limits
  36.  
  37. ' ---------------- Functions
  38.  
  39. DIM OffT,OffL,OffB,OffR
  40.  
  41. LONG FN MakePort&(RPtr&)        
  42.   CALL GETPORT(OldPort&)             
  43.   BLOCKMOVE RPtr&,VARPTR(OffT),8
  44.   MemAvail& = FN FREEMEM
  45.   RowBytes = ((OffR+15)/16) * 2
  46.   MapSz& = RowBytes * ((OffB-OffT)+1) + 14' 14 bytes for BMap record
  47.   LONG IF MapSz& < MemAvail& + 25000'24K extra for window memory!
  48.     OffPort& = FN NEWPTR(192)
  49.     CALL OPENPORT(OffPort&)       'copies port info from active port
  50.     BLOCKMOVE VARPTR(OffT),OffPort&+16,8'make port rect right size
  51.     VisRgn& = PEEK LONG (OffPort&+24)'set vis rgn & clip rgn to size
  52.     CALL RECTRGN(VisRgn&,OffT)
  53.     ClipRgn& = PEEK LONG (OffPort&+28)
  54.     CALL RECTRGN(ClipRgn&,OffT)
  55.     
  56.     Map& = FN NEWPTR(MapSz&)      'get a pointer for bitmap and screenbits
  57.     POKE LONG Map&,Map&+14        'screenbits starts here
  58.     POKE WORD Map&+4,RowBytes     'bytes per row
  59.     BLOCKMOVE VARPTR(OffT),Map&+6,8'rectangle
  60.     CALL SETPORTBITS(#Map&)       'make our screenbits data bits for port
  61.     PEN ,,,,0                     'color background of bitmap black
  62.     CALL PAINTRECT(OffT)          '<<< change to suit your app
  63.   END IF
  64.   CALL SETPORT(OldPort&) 
  65. END FN = OffPort&
  66.  
  67. '---------------------------------------
  68.  
  69. LONG FN KillPort(KPort&)
  70.   LONG IF KPort& <> 0
  71.     CALL CLOSEPORT(KPort&)        'nukes visrgn and cliprgn on its own...
  72.     OSErr = FN DISPOSPTR(PEEK LONG(KPort&+2)-14)' nukes bitmap
  73.     OSErr = FN DISPOSPTR(KPort&)  '   and the port's memory
  74.   END IF
  75. END FN 
  76.  
  77. '---------------------------------------
  78.  
  79. LONG FN GetPictRect(ResID,RectPtr&)
  80.   Hndl& = FN GETPICTURE(ResID)
  81.   LONG IF Hndl&
  82.     BLOCKMOVE PEEK LONG (Hndl&)+2,RectPtr&,8'copy to dest rect
  83.   END IF
  84. END FN
  85.  
  86. '---------------------------------------
  87.  
  88. DIM PictT,PictL,PictB,PictR
  89. DIM PortT,PortL,PortB,PortR
  90.  
  91. LONG FN SetUpOffScrn&(ResID,NumShapes)  
  92.   FN GetPictRect(ResID,VARPTR(PictT))
  93.   ShHt = PictB-PictT              'compute height and width (GLOBAL!!!)
  94.   ShWdth = PictR-PictL  
  95.   PortB = ShHt                    'PortL and PortT = 0
  96.   PortR = ShWdth * NumShapes 
  97. END FN = FN MakePort&(VARPTR(PortT))'return with grafport pointer 
  98.  
  99. '-------------------------- 
  100.  
  101. DIM ShT,ShL,ShB,ShR
  102. DIM PT,PL,PB,PR
  103.  
  104. LONG FN DrawOffScreen (OffPort&,ResID,NumShapes,ShapeWdth)
  105.   CALL GETPORT(OldPort&)
  106.   CALL SETPORT(OffPort&) 
  107.   ShT = 0 : ShL = 0 
  108.   FOR Shape = 0 TO NumShapes - 1
  109.     Hndl& = FN GETPICTURE(ResID+Shape)
  110.     LONG IF Hndl&
  111.       PICTURE (ShL,ShT),Hndl& 
  112.     END IF
  113.     ShL = ShL + ShapeWdth       
  114.   NEXT
  115.   CALL SETPORT(OldPort&)
  116. END FN
  117.  
  118. '----------------------------------------
  119.  
  120. DIM LimT,LimL,LimB,LimR
  121.  
  122. LONG FN MoveShape(Num,NumShapes)
  123.   BLOCKMOVE VARPTR(MoveLimits(Num,0)),VARPTR(LimT),8'
  124.   IF ShRect(Num,1) <= LimL OR ShRect(Num,3) => LimR THEN XInc(Num)=XInc(Num)* -1 
  125.   IF ShRect(Num,0) <= LimT OR ShRect(Num,2) => LimB THEN YInc(Num)=  YInc(Num)* -1 
  126.   CALL OFFSETRECT(ShRect(Num,0),XInc(Num),YInc(Num))'move to new pos
  127.   
  128.   ' are we going to collide with another shape?
  129.   
  130.   FOR ColCk = 0 TO GTotalShapes-1
  131.     Collision = FN SECTRECT(ShRect(Num,0),ShRect(ColCk,0),T)
  132.     LONG IF Collision AND ColCk <> Num 
  133.       XInc(Num) = XInc(Num)*-1
  134.       YInc(Num)=YInc(Num)*-1
  135.       CALL OFFSETRECT(ShRect(Num,0),XInc(Num),YInc(Num)) 
  136.     END IF
  137.   NEXT    
  138.   
  139.   IntShape(Num) = IntShape(Num) + 1 
  140.   IF IntShape(Num) > NumShapes-1 THEN IntShape(Num) = 0
  141. END FN
  142.  
  143. '----------------------------------------
  144.  
  145. DIM ShpT,ShpL,ShpB,ShpR
  146.  
  147. LONG FN DrawShape(ShapeNum,NumShapes,SWdth,SHt,OnScrn&,OffScrn&)
  148.   FN MoveShape(ShapeNum,NumShapes)'  update position
  149.   
  150.   ShpT = 0
  151.   ShpL = IntShape(ShapeNum) * SWdth'start of shape data offscrn 
  152.   ShpB = SHt 
  153.   ShpR = ShpL + SWdth 
  154.   
  155.   CALL COPYBITS(#OffScrn&+2,#OnScrn&+2,ShpT,ShRect(ShapeNum,0),8,0)
  156. END FN
  157.  
  158.  
  159. '-------------------------- Main Program ----------------------------
  160.  
  161. SaucerOffScrn& = FN SetUpOffScrn&(SaucerID,SaucerPICTs)
  162. LONG IF SaucerOffScrn&            'only continue if valid!
  163.   SaucerWdth = ShWdth             'returned globally from FN SetUpOffScrn
  164.   SaucerHt = ShHt
  165.   
  166.   RockOffScrn& = FN SetUpOffScrn&(RockID,RockPICTs)
  167.   LONG IF RockOffScrn&            'are we still okay?
  168.     RockWdth = ShWdth             'returned globally from FN SetUpOffScrn
  169.     RockHt   = ShHt
  170.     
  171.     
  172.     ' -------------------- Define Saucer Data ---------------------
  173.     
  174.     ' *** Shape #1 ***    'the first shape is the zeroth in array
  175.     '
  176.     ' establish initial position
  177.     '
  178.     CALL SETRECT(ShRect(0,0),10,20,10+SaucerWdth,20+SaucerHt)
  179.     XInc(0) = 3 : YInc(0) = 3     'initial direction and speed
  180.     
  181.     ' *** Shape #2 ***
  182.     CALL SETRECT(ShRect(1,0),200,20,200+SaucerWdth,20+SaucerHt)
  183.     XInc(1) = -3 : YInc(1) = -3   'going up & left a little faster
  184.     
  185.     ' *** Shape #3 ***
  186.     CALL SETRECT(ShRect(2,0),75,190,75+SaucerWdth,190+SaucerHt)
  187.     XInc(2) = 3 : YInc(2) = 2              
  188.     
  189.     ' *** Shape #4 ***
  190.     CALL SETRECT(ShRect(3,0),95,230,95+SaucerWdth,230+SaucerHt)
  191.     XInc(3) = 3 : YInc(3) = 3
  192.     
  193.     ' *** Shape #5 ***
  194.     CALL SETRECT(ShRect(4,0),230,210,230+SaucerWdth,210+SaucerHt)
  195.     XInc(4) = 2 : YInc(4) = 3
  196.     
  197.     ' ------------------ Define Rock Data -----------------------
  198.     
  199.     ' *** Shape #6 ***    
  200.     CALL SETRECT(ShRect(5,0),110,110,110+RockWdth,110+RockHt)
  201.     XInc(5) = 4 : YInc(5) = 4
  202.     
  203.     ' *** Shape #7 ***
  204.     CALL SETRECT(ShRect(6,0),160,160,160+RockWdth,160 + RockHt)
  205.     XInc(6) = -4: YInc(6) = 4     'rock moves fast down & left to start
  206.     
  207.     
  208.     ' *** Shape #8 ***
  209.     CALL SETRECT(ShRect(7,0),240,60,240+RockWdth,60+RockHt)
  210.     XInc(7) = -2 : YInc(7) = -2
  211.     
  212.     ' *** Shape #9 ***
  213.     CALL SETRECT(ShRect(8,0),140,60,140+RockWdth,60+RockHt)
  214.     XInc(8) = -4 : YInc(8) = -4
  215.     
  216.     ' *** Shape #10 ***
  217.     CALL SETRECT(ShRect(9,0),40,160,40+RockWdth,160+RockHt)
  218.     XInc(9) = 2 : YInc(9) = -2
  219.     
  220.     ' we're going to animate five saucers and five rocks
  221.     
  222.     TotSaucers = 5 
  223.     TotRocks = 5
  224.     GTotalShapes = 10
  225.     
  226.     
  227.     T = 30 : L = 10 : B = 330 : R = 500 
  228.     WINDOW 1,"",(L,T)-(R,B),3 
  229.     PEN ,,,,0                     ' solid black penpat
  230.     CALL OFFSETRECT(T,-L,-T)
  231.     CALL PAINTRECT(T)
  232.     '
  233.     ' establish movement limits (same as window rect for simplicity)
  234.     '
  235.     FOR Shape = 0 TO GTotalShapes-1          
  236.       BLOCKMOVE VARPTR(T),VARPTR(MoveLimits(Shape,0)),8
  237.     NEXT
  238.     
  239.     CALL GETPORT(CurrPort&)
  240.     FN DrawOffScreen(SaucerOffScrn&,SaucerID,SaucerPICTs,SaucerWdth) 
  241.     FN DrawOffScreen(RockOffScrn&,RockID,RockPICTs,RockWdth)
  242.     
  243.     ' This is the main animation loop
  244.     
  245.     CALL HIDECURSOR
  246.     DO
  247.       T& = FN TICKCOUNT + 1       'establish timing for all Macs
  248.       FOR Saucer = 0 TO TotSaucers-1
  249.         FN DrawShape(Saucer,SaucerPICTs,SaucerWdth,SaucerHt,CurrPort&,SaucerOffScrn&)
  250.       NEXT
  251.       
  252.       FOR Rock = TotSaucers TO TotSaucers+TotRocks-1
  253.         FN DrawShape(Rock,RockPICTs,RockWdth,RockHt,CurrPort&,RockOffScrn&)
  254.       NEXT
  255.       
  256.     DO:UNTIL FN TICKCOUNT > T&
  257.     UNTIL FN BUTTON               'in this case, loop until a mouse click
  258.     CALL SHOWCURSOR
  259.     
  260.     WINDOW CLOSE 1                'clean up our mess and leave
  261.     FN KillPort(RockOffScrn&)  
  262.   END IF
  263.   
  264.   FN KillPort(SaucerOffScrn&)
  265. END IF
  266. 'CALL CLOSERESFILE(ResRef) ' uncomment for Z5
  267. END
  268.  
  269.